perm filename KSIG.FAI[NEW,LCS]2 blob
sn#319874 filedate 1977-12-08 generic text, type T, neo UTF8
00100 TITLE KSIG ; 00100 SUBROUTINE KSIG
00200 ENTRY KSIG,METER,MAKNUM
00300 EXTERNAL NOZERO,.COMM.,ITMSUB,POSI,NFONT
00400 EXTERNAL ALPHA,IFIX,STF,AMOD,CENTX,CIRCLE,NOTWRT,CENTX
00500 KSIG: 0 ; FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
00600 ;00300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(-3/4),RSTJ2
00700 ;00400 C*******************;;;; Z WIPED OUT IN NOTWRT!!! BE CAREFUL WITH S!!!
00800 ;00500 EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
00900 ;00600 1,(R6,RJQ(4))
01000 MOVEI 02,11 ; JA=9
01100 MOVEM 2,.COMM.+1 ; C USES THIS KEY NUM IN NOTWRT
01200 ; COUNTER -- IZ=IABS(J5)
01300 MOVM 15,.COMM.+=26 ; NUMBER OF CALLS ON NOTWRT
01400 ; 01300 C THE CLEF NUM. IT GETS WIPED OUT IN NOTWRT.
01500 ; 01400 JW=1
01600 MOVEI 2,1 ; 01500 R6=0
01700 SETZM METER ; SIZE FACT. 1600 IF(J5.GT.0)JW=2
01800 SKIPLE .COMM.+=26
01900 AOS 2 ; 01700 C THE CODE FOR FLAT OR SHARP
02000 CAIGE 15,144 ; 01800 IF(IZ.LT.100)GO TO 5333
02100 JRST KS1
02200 MOVEI 2,3 ; 01900 JW=3
02300 SUBI 15,144 ; 02000 IZ=IZ-100
02400 ; 2100 WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
02500 KS1: MOVEM 2,JW# ; 02200 5333 CLEF=J6+1
02600 MOVE 3,.COMM.+=27
02700 IDIVI 3,=100 ;CLEF #S ARE 0,1,2,3 (TREB.,BA.,ALT.,TEN.)
02800 MOVEM 4,CLEF#
02900 ; AC4 NOW HAS CLEF NUM. 02400 C CLEF NOW SET IN MAIN PROG.
03000 ; 02500 C IF NO CLEF GIVEN, TREBLE IS USED.
03100 ; 02600 T=10.
03200 JUMPE 3,.+3 ;IF(CLEF.GE.100)R6=.8 MINIS
03300 MOVE 3,[0.8]
03400 MOVEM 3,METER ; METER STORES SIZE FACTOR
03500 MOVSI 13,204500 ; 13 IS T
03600 CAILE 4,1 ;2700 IF(CLEF.GT.1.)T=11.
03700 MOVSI 13,204540
03800 MOVEM 13,T#
03900 CAIN 4,3
04000 JRST KSX
04100 MOVNI 2,(4) ; 02800 S=3-CLEF
04200 ADDI 2,3
04300 SKIPA
04400 KSX: SETO 2, ; 02900 IF(CLEF.EQ.3)S=-1.
04500 FLTR 2,2 ;TLC 2,232000
04600 ;; FADR 2,2
04700 MOVEM 2,S# ; 03000 IF(J5.LT.0)GO TO 253
04800 MOVE 02,.COMM.+=26
04900 JUMPL 02,KS2 ; 03100 W=-3.
05000 MOVN 02,[3.0] ; 03200 YY=4.
05100 MOVSI 3,203400 ; 03300 Z=11.
05200 MOVSI 4,204540 ; 03400 C SHARPS
05300 ; 03500 GO TO 353
05400 JRST KS3 ; 03600 253 W=-4
05500 KS2: MOVN 2,[4.0] ; 03700 YY=3.
05600 MOVSI 3,202600 ; 03800 Z=7.
05700 MOVSI 4,203700 ; 03900 C FLATS
05800 KS3: MOVEM 2,W# ; 04000 353 N=-1
05900 MOVEM 3,YY#
06000 SETOM N#
06100 FADR 4,.COMM.+5 ;4100 Z=Z+R4
06200 MOVE .COMM.+4 ;RX=R3
06300 MOVEM RX#
06400 ; 04300 RA=0
06500 SETZM RA#
06600 ; 04400 C RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
06700 MOVSI 204640
06800 FMPR STF+=8
06900 SKIPE METER ;IF(METER.NE.0) *METER
07000 FMPR METER
07100 MOVEM .COMM.+=27 ; SAVES IT IN J6
07200 MOVEM 15,IZ# ; 04500 DO 553 KA=1,IZ
07300 MOVEI 15,1 ; 04600 J5=JW
07400 KS6: MOVE 02,JW
07500 MOVEM 02,.COMM.+=26 ;04700 R3=RX+RA
07600 MOVE 02,RX
07700 FADR 02,RA
07800 MOVEM 02,.COMM.+4 ; 04800 RA=RA+13.*RSTJ2
07900 MOVE 02,.COMM.+=27
08000 FADRM 02,RA ; 04900 C MOVES OVER FOR NEXT ACCI.
08100 MOVE 2, METER ;GET SIZE 05000 RD=Z
08200 MOVEM 2,.COMM.+7 ;R6=METER
08300 MOVEM 4,RD# ;05100 R4=Z
08400 MOVEM 4,.COMM.+5
08500 SKIPE CLEF ; 05200 IF(CLEF.NE.0)GO TO 7
08600 JRST KS7
08700 CAMG 4,[12.0] ;5300 IF(R4.GT.12.)R4=R4-7.
08800 JRST KS9
08850 JRST KS9-2
08900 ;; MOVN 02,[7.0]
09000 ;; FADRM 02,.COMM.+5 ;05400 GO TO 9
09100 ;; JRST KS9 ; 05500 7 R4=R4-S
09200 KS7: MOVN 02,S
09300 FADRB 02,.COMM.+5
09400 CAMG 2,T ; 05600 IF(R4.GT.T)R4=R4-7.
09500 JRST KS9
09600 MOVN 02,[7.0]
09700 FADRM 02,.COMM.+5 ;5700 ABOVE ARRANGES VERT. POS OF ACCIS.
09800 ; 05800 9 J4=R4
09900 ;;KS9: JSA 16,IFIX
10000 ;; JUMP .COMM.+5
10100 KS9: KIFIX 0,.COMM.+5
10200 MOVEM 00,.COMM.+=25 ;FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
10300 JSA 16,CENTX
10400 JSA 16,NOTWRT ; 06200 Z=RD+W
10500 MOVE 4,W
10600 SKIPG N ; 06300 IF(N.GT.0)Z=RD+YY
10700 MOVE 4,YY ; N WAS -1 1ST TIME.
10800 FADR 4,RD ; 06400 553 N=-N
10900 MOVNS 00,N
11000 CAMGE 15,IZ
11100 AOJA 15,KS6
11200 JRA 16,(16) ; 06500 END
11300
11400 METER: 0 ;24300 SUBROUTINE METER
11500 JSA 16,NOZERO ; 25100 CALL NOZERO(R7)
11600 JUMP .COMM.+=8 ; 25200 JZ=J3
11700 SETZM KSIG ;FLAG FOR DOUBLE METERS 3/4+5/8 ETC.
11800 SKIPN 2,.COMM.+=9 ;IF(R8.EQ.0)GO TO MT1
11900 JRST MT1
12000 MOVEM 2,RD8# ;SAVE R8 IN RD8
12100 SETZM .COMM.+=9 ;R8=0
12200 MOVE .COMM.+=8 ;RD7=R7 SIZE
12300 MOVEM RD7#
12400 MOVE .COMM.+4 ;RD3=R3
12500 MOVEM RD3#
12600 MOVE .COMM.+2 ;CENTD=CENTR
12700 MOVEM CENTD#
12800 SETOM KSIG ; SET FLAG TO -1
12900 MOVE .COMM.+5 ;SAVE R4 IN RD4
13000 MOVEM RD4#
13100 MOVE 2,[12.0] ;POS FOR PLUS SIGN
13200 MOVE 3,[19.0] ;POS FOR 2ND METER
13300 MOVE .COMM.+=27 ;IF(J6 .GE. 10)INCREASE SPACE.
13400 CAIGE =10
13500 JRST MT6
13600 FADR 2,[5.0]
13700 FADR 3,[5.0]
13800 MT6: SKIPN 1,.COMM.+=11 ;IF(R10.EQ.0)R10=1
13900 MOVE 1,[1.0]
14000 SKIPN 4,.COMM.+=12 ;IF(R11.EQ.0)R11=R10
14100 MOVE 4,1 ;R10 MOVES +, R11 MOVES 2ND METER
14200 FMPR 2,1
14300 FMPR 3,4 ;P10, P11 CAN CHANGE SPREAD BETWEEN METERS
14400 MOVEM 2,PLUS#
14500 MOVEM 3,METR2#
14600 SETZM .COMM.+=12 ;R11 MUST =0 FOR OTHER PLACES
14700 MT1: MOVE 02,.COMM.+=24
14800 MOVEM 02,JZ# ; 25300 RY=R4+8.*.COMM.+=8
14900 MOVE 02,.COMM.+=8
15000 SKIPE 3,.COMM.+6;IF TOP NUM=0, SINGLE METER. MOVE DN 1.2--P5=TOP NUM
15100 JRST SINGL
15200 FADR 2,[0.25]
15300 MOVEM 2,.COMM.+=8 ;INCREASE SIZE(1.25) FOR SINGLE METER.
15400 MOVE [0.7]
15500 FADRM .COMM.+5
15600 SINGL: FSC 02,3
15700 FADRB 02,.COMM.+5
15800 ; FADR 2,[2.0] ;ADD 2 TO RAISE IT
15900 MOVEM 02,RY# ; 26300 R4=RY HEIGHT
16000 MOVE 1,.COMM.+7 ;25500 RW=R6
16100 MOVEM 1,RW# ; 25600 C BOTTOM NUM
16200 MOVE 02,.COMM.+=8 ;25800 R6=.COMM.+=8
16300 MOVEM 02,.COMM.+7 ;25900 RR6=R6
16400 MOVEM 02,RR6# ; 26000 C SIZE FOR BDR40 -- OR =1
16500 ; 26200 M=0
16600 SETZM M# ; 26400 2 .COMM.+=8=0
16700 ;; JUMPG 3,MT2 ;IF(R6.NE.0)GO TO MT2
16800 ;; MOVE [1.9]
16900 ;; FADRM .COMM.+5 ;R4=R4+2
17000 MT2: SETZM .COMM.+=8 ; .COMM.+=8=0 FOR BDR FONT??
17100 ; 26600 CC IF(R5.NE.99)GO TO 1
17200 SKIPN .COMM.+6;IF TOP NUM.=0 SKIP OVER
17300 JRST SINGLE
17400 MOVSI 02,207550 ; 26700 IF(R5.LT.90)GO TO 3
17500 CAMLE 02,.COMM.+6
17600 JRST MT3 ; 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
17700 ; 26900 M=-1
17800 SETOM M ; 27000 IF(R5.NE.98)GO TO 4
17900 MOVSI 02,207610
18000 CAME 02,.COMM.+6
18100 JRST MT4 ; 27100 C NEXT FOR LINE THROUGH C.
18200 ; 27200 RZ=R6
18300 ;; MOVE 02,.COMM.+7
18400 ;; MOVEM 02,RZ#
18500 ; 27300 RY=R4
18600 ;; MOVE 02,.COMM.+5
18700 ;; MOVEM 02,RY
18800 MOVE 02,POSI+=9 ; 27400 RA=POS
18900 MOVEM 02,RA# ; 27500 R6=RX3
19000 MOVE 02,.COMM.+=23
19100 MOVEM 02,.COMM.+7 ;27600 C TO LINE UP WITH R3
19200 MOVEI 02,2 ; 27700 J10=2
19300 MOVEM 02,.COMM.+=31 ; FOR THICK LINE
19400 ; 27810 CC R5=9.8+R4
19500 MOVN 02,[3.8] ; 28000 R4=R4-3.8
19600 FADRB 02,.COMM.+5 ;28050 R5=R4+5.6
19700 FADR 02,[5.6]
19800 MOVEM 02,.COMM.+6 ;28100 J7=0
19900 SETZM .COMM.+=28; 28200 R8=0
20000 SETZM .COMM.+=9 ; 28300 CALL ITMSUB
20100 JSA 16,ITMSUB ; 28400 POS=RA
20200 MOVE 02,RA
20300 MOVEM 02,POSI+=9 ; 28500 R4=RY
20400 MOVE 02,RY
20500 MOVEM 02,.COMM.+5 ;28600 R6=RZ
20600 MOVE 02,RR6
20700 MOVEM 02,.COMM.+7 ; GET BACK THE RIGHT PARAMS.
20800 MT4: MOVE 02,[9999.0] ; 28900 4 R5=9999.
20900 MOVEM 02,.COMM.+6 ;29100 C TO CENTER 12S AND 16S
21000 MT3: JSA 16,MAKNUM ; 29200 3 CALL MAKNUM(R5)
21100 JUMP .COMM.+6 ;29300 IF(M)RETURN
21200 SKIPGE M
21300 JRST MT5
21400 SINGLE: SETOM M ; 29500 M=-1
21500 ; STICK AROUND FOR BOTTOM NUM
21600 MOVE 02,RR6 ; 29700 R6=RR6
21700 MOVEM 02,.COMM.+7 ;29600 R4=RY-4.*RR6
21800 FSC 02,2
21900 FSBR 02,RY
22000 MOVNM 02,.COMM.+5 ;29800 R5=RW
22100 MOVE 1,RW#
22200 MOVEM 1,.COMM.+6 ;29900 C GET BOTTOM NUM
22300 MOVE 02,JZ ; 30000 J3=JZ
22400 MOVEM 02,.COMM.+=24 ;30100 R8=0
22500 SETZM .COMM.+=9 ; 30200 GO TO 2
22600 JUMPG 1,MT2 ;30300 END
22700 MT5: SKIPL KSIG ; SKIP IF DOUBLE METER
22800 JRA 16,(16)
22900 SETZM KSIG
23000 MOVE RD4 ;GET BACK VERT POS.
23100 FADR [4.0] ; ADD FOR + SIGN
23200 MOVEM .COMM.+5 ;PUT IT R4
23300 MOVE .COMM.+=10 ;RX=R9
23400 MOVEM RX
23500 MOVE RD7 ;R6=R7 SIZE
23600 MOVEM .COMM.+7
23700 MOVEM .COMM.+8
23800 SETZM .COMM.+=10 ;R9=0
23900 SETZM .COMM.+=9 ;R8=0
24000 MOVEI =9 ;JA=9
24100 MOVEM .COMM.+1
24200 MOVEI =14 ;J5=14
24300 MOVEM .COMM.+=26
24400 MOVE [45.0]
24500 FMPR STF+=8 ;*RSTJ2
24600 FMPR RD7 ;*SIZE
24700 FADR CENTD ;ADD TO 'CENTR'
24800 MOVEM .COMM.+2 ; CENTR
24900 MOVE METR2 ;MOVE TO RIGHT 25 BASIC NOTCHES
25000 FMPR STF+=8 ;*RSTJ2
25100 FMPR RD7
25200 KIFIX
25300 ADDB JZ ;SHIFT FOR SECOND METER
25400 MOVEM .COMM.+=24 ;PUT IT IN J3
25500 MOVE PLUS ;SHIFT + 10 NOTCHES TO RIGHT OF ORIG.
25600 FMPR STF+=8 ;*RSTJ2
25700 FMPR RD7 ;*SIZE
25800 FADR RD3 ;+ ORIGINAL CONTENTS OF R3
25900 MOVEM .COMM.+4 ;ADJUST R3
26000 JSA 16,NOTWRT ;GO MAKE A +
26100 MOVE RD4 ;GET BACK BASIC R4
26200 MOVEM .COMM.+5
26300 MOVE RD8 ;PUT RD8 AND RX INTO R5 AND R6
26400 MOVEM .COMM.+6
26500 MOVE 2,RX
26600 MOVEM 2,.COMM.+7
26700 MOVE RD7 ;GET BACK SIZE
26800 MOVEM .COMM.+8 ;PUT IT IN R7
26900 MOVE [20.0] ;SHIFT MORE TO RIGHT
27000 CAML 2,[10.0] ;ADD MORE SPACE IF BOT. # >10
27100 FADR [5.0]
27200 FMPR STF+=8 ;*RSTJ2
27300 FMPR RD7
27400 KIFIX
27500 ADDB JZ
27600 MOVEM .COMM.+=24 ;NEW POS IN J3
27700 JRST MT1
27800
27900
28000 MAKNUM: 0 ; SUBROUTINE MAKNUM(RNUM)
28100 ;100 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
28200 ;200 EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
28300 ;300 1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
28400 ;400 1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
28500 ;500 1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
28600 ;600 DATA RS/10.0/,RBX/1.0/
28700 MOVE 11,@(16) ;GET RNUM (KEEP 11 CLEAN IN OTHER ROUTINES)
28800 MOVE 02,.COMM.+=9 ; RB8=R8
28900 MOVEM 02,RB8#
29000 MOVE 02,.COMM.+=24 ; J3X=J3
29100 MOVEM 02,J3X# ; P7=0=BDR40; =1=BDI40; =2=PRIM.
29200 JSA 16,NOZERO ; CALL NOZERO(R6)
29300 JUMP .COMM.+7
29400 MOVE 02,.COMM.+7 ; R5=R6
29500 MOVEM 02,.COMM.+6 ; UPPER CASE - BDR40
29600 MOVSI 02,206620 ; R6=48000000.0+(R7+50.)*10000.
29700 FADR 02,.COMM.+=8
29800 FMPR 02,[10000.0]
29900 FADR 02,[48000000.0]
30000 MOVEM 02,.COMM.+7
30100 MOVE 02,[99999999.0] ; R7=99999999.0
30200 MOVEM 02,.COMM.+=8
30300 ; 32500 C BLANKS
30400 ; 32700 IF(RNUM.NE.9999.)GO TO 2
30500 CAME 11,[9999.0]
30600 JRST MN2
30700 ; 32800 C NEXT FOR 'C'OMMON TIME
30800 ; 32900 RNUM=12.
30900 MOVSI 11,204600
31000 ; 33000 C MAKES A 'C'
31100 ; 33100 R4=R4-2.2
31200 MOVN 02,[2.2]
31300 FADRM 02,.COMM.+5 ;33200 C .2 FOR BAD POS. OF LETTERS
31400 JRST MN4 ; 33300 GO TO 4
31500 MN2: SETZM ONE# ; 33500 2 ONE=0
31600 KIFIX 11,11 ; 33600 RNUM=IFIX(RNUM)
31700 ;; JSA 16,IFIX
31800 ;; JUMP 11
31900 ;; MOVEM 11
32000 FLTR 11,11 ;TLC 11,232000
32100 ;; FADR 11,11
32200 ; 33700 C SO MISTAKES (I.E. 2.2) WON'T BREAK THE PROG.
32300 ; 33800 IF(RNUM.EQ.1.)ONE=3.
32400 CAME 11,[1.0]
32500 JRST .+3
32600 MOVSI 02,202600
32700 MOVEM 02,ONE
32800 CAMLE 11,[9.0] ;33900 IF(RNUM.GT.9.)GO TO 3
32900 JRST MN3 ;34000 C JUMP FOR 2 OR 3 DIGIT NUMBER
33000 ; 34100 4 R6=R6+RNUM*100.+47.
33100 ;;MN4: MOVSI 02,206570
33200 MN4: MOVSI 03,207620
33300 FMPR 03,11
33400 FADR 3,[47.0]
33500 FADRM 3,.COMM.+7 ; 34200 C PUTS BLANK ON END (.47)
33600 JRST MN1 ; 34300 GO TO 1
33700 ; 34500 3 RJY=10.
33800 MN3: MOVSI 3,204500 ; 3 NOW HAS RJY
33900 ;; MOVEM 02,RJY#
34000 CAML 11,[100.0] ; 34600 IF(RNUM.GE.100.)RJY=100.
34100 MOVSI 3,207620
34200 ;; MOVEM 03,RJY#
34300 ; 34700 B=IFIX(RNUM/RJY)
34400 MOVE 02,11
34500 ;; FDVR 02,RJY
34600 FDVR 2,3
34700 KIFIX 2,2 ;JSA 16,IFIX
34800 ; JUMP 2
34900 ;; MOVEM B
35000 ;; JSA 16,FLOAT
35100 ;; JUMP B#
35200 FLTR 2,2 ;TLC 0,232000
35300 ;; FADR 0,0
35400 MOVEM 2,B
35500 ; 34800 C=AMOD(RNUM,RJY)
35600 JSA 16,AMOD
35700 JUMP 11
35800 JUMP 3
35900 MOVEM C#
36000 ; 34900 IF(RNUM.LT.100)GO TO 7
36100 CAMGE 11,[100.0]
36200 JRST MN7
36300 ; 35000 D=IFIX(C/10.)
36400 MOVE 02,C
36500 FDVR 02,[10.0]
36600 KIFIX 2,2 ;JSA 16,IFIX
36700 ;; JUMP 2
36800 ;; MOVEM D
36900 ;; JSA 16,FLOAT
37000 ;; JUMP D
37100 FLTR 2,2 ;TLC 0,232000
37200 ; FADR 0,0
37300 MOVEM 2,D#
37400 ; 35100 C=AMOD(C,10.)
37500 JSA 16,AMOD
37600 JUMP C
37700 JUMP [10.0]
37800 MOVEM C
37900 ; 35200 IF(C.EQ.1.)ONE=ONE+3.
38000 CAME [1.0]
38100 JRST .+3
38200 MOVSI 02,202600
38300 FADRM 02,ONE
38400 ; 35300 R7=C*1000000.+999999.0
38500 FMPR 0,[1000000.0]
38600 FADR 0,[999999.0]
38700 MOVEM 0,.COMM.+=8
38800 ; 35400 C=D
38900 MOVE 02,D
39000 MOVEM 02,C
39100 ; 35500 7 R6=R6+B*100.+C
39200 ;;MN7: MOVE 02,.COMM.+7
39300 ;; FADR 02,C
39400 MN7: MOVSI 03,207620
39500 FMPR 03,B#
39600 FADR 3,C
39700 FADRM 3,.COMM.+7
39800 ; 35600 IF(B.EQ.1.)ONE=ONE+3.
39900 MOVSI 02,201400
40000 CAME 02,B
40100 JRST .+3
40200 MOVSI 3,202600
40300 FADRM 3,ONE
40400 ; 35700 IF(C.EQ.1.)ONE=ONE+3.
40500 CAME 02,C
40600 JRST .+3
40700 MOVSI 02,202600
40800 FADRM 02,ONE
40900 ; 35800 B=R5
41000 MOVE 02,.COMM.+6
41100 MOVEM 02,B
41200 ; 35900 IF(RNUM.GE.100.)B=B*2
41300 CAMGE 11,[100.0]
41400 JRST .+3
41500 MOVSI 02,202400
41600 FMPRB 02,B
41700 ; 36000 J3=J3-RS*RSTJ2*B
41800 FMPR 02,[10.0]
41900 FMPR 02,STF+=8
42000 KIFIX 2,2 ;JSA 16,IFIX
42100 ; JUMP 2
42200 SUB 2,.COMM.+=24
42300 MOVNM 2,.COMM.+=24
42400 ; 36100 C FOR 2 DIGIT NUMBER
42500 ; 36600 C ADJUSTS FOR 11, ETC.
42600 ; 36900 1 J3=J3+ONE*R5*RSTJ2
42700 MN1: MOVE 02,.COMM.+6
42800 FMPR 02,ONE
42900 FMPR 02,STF+=8
43000 KIFIX 2,2 ;JSA 16,IFIX
43100 ADDM 2,.COMM.+=24 ; 37000 C CENTERS THE NUMBER '1'
43200 MOVEM 11,RNUM# ;37100 CALL ALPHA
43300 MOVE 2,NFONT
43400 MOVEM 2,TMPF#
43500 JSA 16,ALPHA ; 37200 J3=J3X
43600 MOVE 2,TMPF
43700 MOVEM 2,NFONT ;RESTORE FONT TO WHATEVER IT WAS BEFORE
43800 MOVE 02,J3X#
43900 MOVEM 02,.COMM.+=24
44000 SKIPN RB8 ; 37300 IF(RB8.EQ.0)RETURN
44100 JRA 16,1(16) ;37400 C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
44200 FLTR 3,.COMM.+=24 ;MOVE 3,.COMM.+=24 37500 R3=J3-R5
44300 FSBR 3,.COMM.+6
44400 MOVEM 3,.COMM.+4
44500 SKIPE .COMM.+=31 ;37600 IF(J10.EQ.0)J10=1
44600 JRST .+3
44700 MOVEI 02,1
44800 MOVEM 02,.COMM.+=31 ;USE J10 FOR EVEN THICKER BOX AND CIRC.
44900 ; 37800 IF(RNUM.GT.9)R3=R3+R5*RBX
45000 MOVE 11,RNUM ;GET BACK RNUM (11 WIPED OUT WHEN PLOTTING)
45100 CAMG 11,[9.0]
45200 JRST .+4
45300 MOVSI 02,201400
45400 FMPR 02,.COMM.+6
45500 FADRM 02,.COMM.+4
45600 ; 37900 C TO SET CENTER IF(RB8.EQ.2)GO TO 5
45700 MOVSI 02,202400
45800 CAMN 02,RB8
45900 JRST MN5
46000 MOVE 02,[0.05] ;38100 R4=R4+R5+.1+.05/R5
46100 FDVR 02,.COMM.+6
46200 FADR 2,[0.1]
46300 FADR 02,.COMM.+6
46400 FADRM 02,.COMM.+5
46500 ; 38200 C END OF ABOVE IS FOR SMALL CIRCLES.
46600 MOVSI 02,203440 ;38300 B=4.5
46700 ;; MOVEM 02,B
46800 ; 38400 IF(RNUM.GE.100.)B=5.5
46900 CAML 11,[100.0]
47000 ;; CAMLE 02,11
47100 ;; JRST .+3
47200 MOVSI 02,203540
47300 ;; MOVEM 02,B
47400 ;; MOVE 02,B
47500 FMPRM 02,.COMM.+6 ;38500 R5=R5*B
47600 ;; MOVEI 02,14 ;38600 JA=12
47700 ;; MOVEM 02,.COMM.+1
47800 SETZM .COMM.+=27 ; 38700 J6=0
47900 SETZM .COMM.+=28 ; 38800 J7=0
48000 MOVE 02,.COMM.+=31 ;38900 J8=J10
48100 MOVEM 02,.COMM.+=29 ;39000 CALL CENTX
48200 JSA 16,CENTX
48300 JSA 16,CIRCLE ;39100 CALL SLUR
48400 JRA 16,1(16) ;39200 RETURN
48500 ;;MN5: MOVEI 02,4 ;39400 5 JA=4
48600 ;; MOVEM 02,.COMM.+1
48700 MN5: MOVSI 02,203600 ;39500 B=6
48800 ;; MOVEM 02,B
48900 ; 39600 R9=0
49000 SETZM .COMM.+=10 ; 39700 IF(RNUM.LT.100.)GO TO 8
49100 CAMGE 11,[100.0]
49200 JRST MN8 ; 39800 B=9.
49300 MOVSI 02,204440
49400 ;; MOVEM 02,B
49500 MOVSI 1,203600 ; 39900 R9=R5*6.
49600 FMPR 1,.COMM.+6
49700 MOVEM 1,.COMM.+=10 ;40000 C MAKES RECTANGLE IF ↑100
49800 MN8: MOVE 03,[0.7] ; 40100 8 R4=R4+R5*.7+.1
49900 FMPR 03,.COMM.+6
50000 FADR 3,[0.1]
50100 FADRM 3,.COMM.+5 ; 40200 R8=R5*B
50200 ;; MOVE 02,.COMM.+6
50300 ;; FMPR 02,B
50400 FMPR 2,.COMM.+6
50500 MOVEM 02,.COMM.+=9 ;40300 J5=50
50600 MOVEI 02,62
50700 MOVEM 02,.COMM.+=26 ;40400 CALL ITMSUB
50800 JSA 16,ITMSUB ; 40500 C RETURNS ORIG. HORIZ. POS.
50900 JRA 16,1(16) ;40600 END
51000 END